home *** CD-ROM | disk | FTP | other *** search
/ Nebula 1 / Nebula One.iso / Internet / WWW / Perl_WWW_Utilities / MHonArc / lib / mhtxt2022.pl < prev    next >
Encoding:
Text File  |  1995-12-28  |  4.3 KB  |  158 lines

  1. ##---------------------------------------------------------------------------##
  2. ##  File:
  3. ##      mhtxt2022.pl
  4. ##  Author:
  5. ##      NIIBE Yutaka    gniibe@mri.co.jp
  6. ##    (adapted from mhtxtplain.pl by Earl Hood <ehood@convex.com>)
  7. ##  Date:
  8. ##    Thu Dec 28 21:24:58 CST 1995
  9. ##  Description:
  10. ##    Library defines routine to filter text/plain body parts that
  11. ##    use the ISO-2022 Japanese character sets into HTML for MHonArc.
  12. ##    Filter routine can be registered with the following:
  13. ##
  14. ##              <MIMEFILTERS>
  15. ##              text/plain:m2h_text_plain_iso2022'filter:mhtxt2022.pl
  16. ##              </MIMEFILTERS>
  17. ##
  18. ##    This will override the default text/plain filter used by
  19. ##    MHonArc.
  20. ##
  21. ##    Filter is based on the following RFCs:
  22. ##
  23. ##    RFC-1468 I
  24. ##        J. Murai, M. Crispin, E. van der Poel, "Japanese Character
  25. ##        Encoding for Internet Messages", 06/04/1993. (Pages=6)
  26. ##
  27. ##    RFC-1554  I
  28. ##        M. Ohta, K. Handa, "ISO-2022-JP-2: Multilingual Extension of  
  29. ##        ISO-2022-JP", 12/23/1993. (Pages=6)
  30. ##
  31. ##---------------------------------------------------------------------------##
  32. ##    MHonArc -- Internet mail-to-HTML converter
  33. ##    Copyright (C) 1995    NIIBE Yutaka, gniibe@mri.co.jp
  34. ##                Earl Hood, ehood@convex.com
  35. ##
  36. ##    This program is free software; you can redistribute it and/or modify
  37. ##    it under the terms of the GNU General Public License as published by
  38. ##    the Free Software Foundation; either version 2 of the License, or
  39. ##    (at your option) any later version.
  40. ##
  41. ##    This program is distributed in the hope that it will be useful,
  42. ##    but WITHOUT ANY WARRANTY; without even the implied warranty of
  43. ##    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  44. ##    GNU General Public License for more details.
  45. ##
  46. ##    You should have received a copy of the GNU General Public License
  47. ##    along with this program; if not, write to the Free Software
  48. ##    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  49. ##---------------------------------------------------------------------------##
  50.  
  51. package m2h_text_plain_iso2022;
  52.  
  53. $Url     = '(http://|ftp://|afs://|wais://|telnet://|gopher://|' .
  54.             'news:|nntp:|mid:|cid:|mailto:|prospero:)';
  55. $UrlExp  = $Url . q%[^\s\(\)\|<>"']*[^\.;,"'\|\[\]\(\)\s<>]%;
  56. $HUrlExp = $Url . q%[^\s\(\)\|<>"'\&]*[^\.;,"'\|\[\]\(\)\s<>\&]%;
  57.  
  58. ##---------------------------------------------------------------------------
  59. ##    Filter entitizes special characters, and converts URLs to
  60. ##    hyperlinks.
  61. ##
  62. sub filter {
  63.     local($header, *fields, *body) = @_;
  64.     local(@data) = split(/\n/,$body);
  65.  
  66.     $ret = "<PRE>\n";
  67.     for ($i = 0; $i <= $#data; $i++) {
  68.         $_ = $data[$i];
  69.  
  70.     # Process preceding ASCII text
  71.     while(1) {
  72.         if (/^[^\033]+/) {    # ASCII plain text
  73.         $ascii_text = $&;
  74.         $_ = $';
  75.  
  76.         # Replace meta characters in ASCII plain text
  77.         $ascii_text =~ s%\&%\&%g;
  78.         $ascii_text =~ s%<%\<%g;
  79.         $ascii_text =~ s%>%\>%g;
  80.         ## Convert URLs to hyperlinks
  81.         $ascii_text =~ s%($HUrlExp)%<A HREF="$1">$1</A>%gio
  82.             unless $'NOURL;
  83.  
  84.         $ret .= $ascii_text;
  85.         } elsif (/\033\.[A-F]/) { # G2 Designate Sequence
  86.         $_ = $';
  87.         $ret .= $&;
  88.         } elsif (/\033N[ -]/) { # Single Shift Sequence
  89.         $_ = $';
  90.         $ret .= $&;
  91.         } else {
  92.         last;
  93.         }
  94.     }
  95.  
  96.     # Process Each Segment
  97.     while(1) {
  98.         if (/^\033\([BJ]/) { # Single Byte Segment
  99.         $_ = $';
  100.         $ret .= $&;
  101.         while(1) {
  102.             if (/^[^\033]+/) {    # ASCII plain text
  103.             $ascii_text = $&;
  104.             $_ = $';
  105.  
  106.             # Replace meta characters in ASCII plain text
  107.             $ascii_text =~ s%\&%\&%g;
  108.             $ascii_text =~ s%<%\<%g;
  109.             $ascii_text =~ s%>%\>%g;
  110.             ## Convert URLs to hyperlinks
  111.             $ascii_text =~ s%($HUrlExp)%<A HREF="$1">$1</A>%gio
  112.                 unless $'NOURL;
  113.  
  114.             $ret .= $ascii_text;
  115.             } elsif (/\033\.[A-F]/) { # G2 Designate Sequence
  116.             $_ = $';
  117.             $ret .= $&;
  118.             } elsif (/\033N[ -]/) { # Single Shift Sequence
  119.             $_ = $';
  120.             $ret .= $&;
  121.             } else {
  122.             last;
  123.             }
  124.         }
  125.         } elsif (/^\033\$[@AB]|\033\$\([CD]/) { # Double Byte Segment
  126.         $_ = $';
  127.         $ret .= $&;
  128.         while(1) {
  129.             if (/^([!-~][!-~])+/) { # Double Char plain text
  130.             $_ = $';
  131.             $ret .= $&;
  132.             } elsif (/\033\.[A-F]/) { # G2 Designate Sequence
  133.             $_ = $';
  134.             $ret .= $&;
  135.             } elsif (/\033N[ -]/) { # Single Shift Sequence
  136.             $_ = $';
  137.             $ret .= $&;
  138.             } else {
  139.             last;
  140.             }
  141.         }
  142.         } else {
  143.         # Something wrong in text
  144.         $ret .= $_;
  145.         last;
  146.         }
  147.     }
  148.  
  149.     $ret .= "\n";
  150.     }
  151.  
  152.     $ret .= "</PRE>\n";
  153.  
  154.     ($ret);
  155. }
  156.  
  157. 1;
  158.